home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / DELPHI / DIBS.ZIP / CDIBS.INT < prev    next >
Encoding:
Text File  |  1996-08-23  |  3.2 KB  |  83 lines
  1. unit CDIBs;
  2.  
  3. //-----------------------------------------------
  4. // Provides a class for handling DIBs before displaying them.
  5. // TBitmap on the other hand always realizes the palettes and converts the DIB
  6. // to a DDB.
  7. //
  8. // Author: Lubomir Antonov
  9. //-----------------------------------------------
  10.  
  11. interface
  12.  
  13. uses Windows, Classes, Graphics, Clipbrd;
  14.  
  15. type
  16.   // Internal class to hold the image data
  17.   TDIBImage = class
  18.     private
  19.       FRefCount: Integer;
  20.       FMemoryImage: TCustomMemoryStream;
  21.       FWidth: Integer;
  22.       FHeight: Integer;
  23.       FDIBHeader: Pointer;
  24.       //FDIBClrTable: Pointer;
  25.       FDIBBits: Pointer;
  26.       FMonochrome: Boolean;
  27.       procedure Reference;
  28.       procedure Release;
  29.       procedure FreeHandle;
  30.   end;
  31.  
  32.   TDIB = class( TGraphic )
  33.     private
  34.       FImage: TDIBImage;
  35.       procedure FreeContext;
  36.       procedure AssignFromDIB( Source: TDIB );
  37.       procedure AssignFromClipboard( Source: TClipboard );
  38.       procedure AssignFromBitmap( Source: TBitmap );
  39.       procedure AssignToBitmap( Dest: TBitmap );
  40.       procedure InitBIFromBC( var BI: TBitmapInfoHeader;
  41.         var BC: TBitmapCoreHeader; ImageSize: Integer );
  42.       procedure NewImage( NewWidth, NewHeight: Integer; NewMonochrome: Boolean;
  43.         NewImage: TCustomMemoryStream; NewDIBHeader, NewDIBBits: Pointer);
  44.       procedure ReadStream( Size: Longint; Stream: TStream );
  45.       procedure WriteStream( Stream: TStream; WriteSize: Boolean );
  46.       procedure LoadDataFromStream( Stream: TStream );
  47.       function GetMonochrome: Boolean;
  48.       procedure SetMonochrome( Value: Boolean );
  49.       function CopyHeader( Image: TMemoryStream; AWidth, AHeight: Integer ):
  50.         LongInt;
  51.       procedure CopyImage( ALeft, ATop, AWidth, AHeight: Integer;
  52.         AMonochrome: Boolean );
  53.     protected
  54.       procedure AssignTo( Dest: TPersistent ); override;
  55.       function GetEmpty: Boolean; override;
  56.       function GetHeight: Integer; override;
  57.       function GetWidth: Integer; override;
  58.       procedure SetWidth(Value: Integer); override;
  59.       procedure SetHeight(Value: Integer); override;
  60.       procedure ReadData( Stream: TStream ); override;
  61.       procedure WriteData( Stream: TStream ); override;
  62.       function CreateStockPalette: HPALETTE;
  63.     public
  64.       constructor Create; override;
  65.       destructor Destroy; override;
  66.       procedure Assign( Source: TPersistent ); override;
  67.       procedure LoadFromClipboardFormat( AFormat: Word; AData: THandle;
  68.         APalette: HPALETTE ); override;
  69.       procedure LoadFromStream( Stream: TStream ); override;
  70.       procedure LoadFromResourceName( Instance: THandle; const ResName: String );
  71.       procedure LoadFromResourceID( Instance: THandle; ResID: Integer );
  72.       procedure SaveToClipboardFormat( var AFormat: Word; var AData: THandle;
  73.         var APalette: HPALETTE ); override;
  74.       procedure SaveToStream( Stream: TStream ); override;
  75.       procedure CopySection( ALeft, ATop, AWidth, AHeight: Integer );
  76.       function CanConvert16to24: Boolean;
  77.       procedure Convert16to24;
  78.       function DIBToBitmap( Pal: HPALETTE ): HBITMAP;
  79.       property Monochrome: Boolean read GetMonochrome write SetMonochrome;
  80.   end;
  81.  
  82. implementation
  83.